home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE Loader;⓪ (*$Y+,C-,R-,P-*)⓪ ⓪ (* V#477 *)⓪ (*----------------------------------------------------------------------------⓪"25.10.86 TT Grundversion⓪"27.02.87 TT VarSpc wird beim Start gelöscht.⓪"03.03.87 TT Layout wird endlich überprüft.⓪"22.03.87 TT TermProcs werden nun richtig am Ende des Modlevels aufgerufen.⓪"16.05.87 TT Komplette Umstrukturierung zusammen mit 'ModCtrl'⓪"01.07.87 TT Paths.SearchFile wird verwendet.⓪"18.07.87 TT Proc-Vars Loading/Releasing neu, varRef/Len und code/sourceName⓪0werden aus Codefile geholt; ReadMod führt Directory-Search fort,⓪0wenn beim Importieren der Modulname nicht stimmt.⓪"23.07.87 TT ExecBody rettet/restauriert SR und SSP⓪"11.08.87 TT DeAllocate korrekt, wenn Fehler bei ReadMod⓪"25.08.87 TT SplitName korigiert.⓪"26.08.87 TT CallModule kann auch gelinkte (TOS) Prg. starten⓪"08.09.87 TT Bei neuem Process wird "parent's basepage" gesetzt⓪"17.10.87 TT LoadModule auch für TOS-Prgs.⓪"15.01.88 TT ReadMod: Erkennt illeg. Layout sofort; FClose, wenn RETURN⓪0aus ReadMod wg. 'no memory'.⓪0Seltsam. Ich meine, ich hätte diese Fehler schon mal behoben...⓪"16.01.88 TT Kennung/Bit 4 als Flag f. 'procSym' wird erkannt⓪"22.01.88 TT Kein Search bei Call/Load v. Prgs.; beim Laden v. Prgs. wird⓪0erste Hälfte der Basepage gerettet und bei Exec zurückkopiert⓪"23.01.88 TT Search wieder drin, Current Dirs/Drv werden bei prgExec gesetzt⓪"04.03.88 TT layout zw. 0 und 15 erlaubt (bisher nur 0).⓪"14.05.88 TT Module mit Namen > 8 Zeichen ausführbar.⓪"08.06.88 TT Gecrunchte Module können gelinkt werden. Nur wenn Exportliste⓪0nicht vorhanden ist, gibt's 'ne Fehlermeldung.⓪"10.06.88 TT PRG-Files werden wiedergefunden, wenn geladen.⓪"27.06.88 TT Wenn Modul nicht gefunden, wird wieder richtige Melgung ange-⓪0zeigt.⓪"30.09.88 TT ALLOCATE statt SysAlloc bei InitPrgSpace (da sowieso gleich⓪0wieder freigegeben).⓪"05.11.88 TT Release nun im Loader über Proc-Var implementiert⓪"10.12.88 TT Pexec geändert, damit mit MOSLink lauffähig⓪"20.12.88 TT Pexec korrigiert: Speicher wird wieder freigegeben⓪"01.01.89 TT Infinite loop bei PrepareExec & release0 behoben (zirk. Importe)⓪"17.02.89 TT Nicht geladene, gelinkte Prgs liefern wieder korrekten Exitcode⓪"12.06.89 TT zirkulare Importe werden im Loader automatisch gelöst, Freigabe⓪0nun auch schneller.⓪"04.07.89 TT Release nochmals überarbeitet und korrigiert⓪0>>> Freigabe zusammen mit MODCtrl/MODBase in MAUS M & MS.⓪"04.07.89 TT Bei geladenen Prgs wird DATA-Bereich erst beim Starten kopiert.⓪"06.07.89 TT Importierte Module dürfen Load/CallModule schon aufrufen, bevor⓪0Hauptmodul init. ist (um z.B. Treiber nachzuladen). Es gibt⓪0übrigens *keine* Probleme, wenn beide Programm dasselbe Modul⓪0importieren. Je nach Import-Reihenfolge wird dann das Modul⓪0entweder schon im 1. Prozeß init. und bleibt dann auch für den⓪02. Prozeß aktiv oder es wird erst im 2. Prozeß init., aber dann⓪0wird es dort bei dem Prozeßende auch wieder deinit. und beim⓪01. Prozeß wiederum neu initialisiert.⓪"20.08.89 TT Pexec verwendet nun wieder mode 0 -> Modload wiederum anpassen⓪"08.09.89 TT Kein Hänger mehr bei Removals⓪"05.11.89 TT Removals werden nun in korrekter Reihenfolge aufgerufen⓪"20.12.89 TT hahaha! 5.11. war auch nicht OK: Reihenfolge war genau andersrum⓪"01.01.90 TT Ich kapiert gar nix mehr... nun wieder wie am 5.11.⓪"31.05.90 TT Non-reentry-Behandlung fertig⓪"16.07.90 TT Nun werden ALLE importierten Module mit non-reentry initial.;⓪0ExecMod räumt Speicher auch bei Fehlern korrekt wieder auf,⓪0dadurch geht auch kein Speicher mehr beim Start geladener Prgs⓪0verloren.⓪"02.10.90 TT prgExec übergibt Prgname, damit TEMPUS 2.10 nicht abstürzt⓪"11.10.90 TT Neue Real-Codes im Header ausgewertet⓪"18.11.90 TT CallModule: DriverList- und Stacksize-Parms raus. Die sollen⓪0später im Modulcode enthalten sein oder von CallModule in⓪0einem extra File selbst gesucht werden.⓪"26.11.90 TT ExecMod: "tooManyMods"-Fehler eingeführt (tritt auf, wenn⓪0ExecList überläuft)⓪"06.12.90 TT MaxModExec jetzt dynamisch in MOSConfig bestimmbar; IsModule()⓪0schließt nun Datei nach Zugriff; Module/Prgs werden nicht mehr⓪0anhand von Suffix sondern am Header erkannt.⓪"14.12.90 TT Die Module mit $Y- werden NACH Aufruf aller Envelope-Routinen⓪0für den Vater-Prozeß aufgerufen, damit die Envlp-Handler dann⓪0noch auf die Vars des Vaters zugreifen können (um z.B. Werte⓪0vom Vater an den Sohn zu kopieren - s. GEMEnv).⓪"17.12.90 TT Die Stacksize wird aus dem Modheader übernommen, falls # 0.⓪"05.02.91 TT Pfad wird aus Modulname bei Error-Msgs entfernt (errHandler);⓪0"BadLayout"-Fehler kommt, wenn's kein Prg/Modul ist (check-⓪0ExecRes).⓪"24.02.91 TT Beim Start von geladenen Prgs wird "p_hitpa" nun korrekt⓪0verwaltet, so daß z.B. TEMPUS 2.10 wieder fehlerfrei läuft;⓪0DefaultStackSize kann nun jeden Wert annehmen, auch Null.⓪"28.02.91 TT CallModule: Wenn 'arg[0]=CHR(127)', wird kein Längenbyte⓪0eingefügt; Geladene Module/Prgs werden freigegeben, sobald der⓪0Clienten-Prozeß terminiert und das Modul nicht mit SysAlloc⓪0geladen wurde.⓪"18.04.91 TT gesetztes Bit 7 (68020-Code) erzeugt keine Fehlermeldung wg.⓪0falscher FPU mehr.⓪"15.09.91 MS Relocate zerstört nicht mehr D3/A4⓪"14.02.92 TT CallSuper statt Supexec⓪"23.02.92 TT Stack wird in "CreateBasePage" alloziert.⓪"12.12.93 TT prgFlags werden bei MM2-Modulen ausgewertet (f. TT-RAM usw.),⓪0bei gelinkten, geladenen Prgs vorerst nicht, da hier nicht klar⓪0ist, wie das geht.⓪"16.01.94 TT Um das zu eigene Real-Format zu ermitteln, wird nicht mehr⓪0FPU() aufgerufen, weil das nicht mit den gelinkten Libs über-⓪0einstimmen muß, sondern es wird RealMode abgefragt.⓪ *---------------------------------------------------------------------------*)⓪ ⓪ (* Beim Relozieren Bus/Addr-Error abfangen ! *)⓪ ⓪ FROM MOSGlobals IMPORT SfxStr, NameStr, PfxStr, MemArea, Overflow, IllegalState;⓪ ⓪ FROM PrgCtrl IMPORT EnvlpCarrier, SetEnvelope, RemoveEnvelope, TermProcess;⓪ ⓪ FROM MOSSupport IMPORT CallSuper;⓪ ⓪ IMPORT SystemError;⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, CADR, ADR, WORD, ADDRESS, TSIZE, LONGWORD, BYTE;⓪ ⓪ FROM Strings IMPORT Upper, Concat, Length, Pos, Copy, Append, Insert, PosLen,⓪4Compare, Relation, Empty, String, Assign, Split, Delete,⓪4StrEqual;⓪ ⓪ FROM Storage IMPORT Inconsistent, SysAlloc, MemAvail, DeAllocate, ALLOCATE;⓪ FROM StorBase IMPORT FullStorBaseAccess;⓪ ⓪ FROM MOSCtrl IMPORT RemovalRoot, RemovalEntry, CallSub, ProcessID, RealMode;⓪ ⓪ FROM SysTypes IMPORT PtrBP;⓪ ⓪ FROM ModBase IMPORT CallEnvelopes, ModLst, ModRef, ModStr, ModEntry,⓪0GetModRef, Release, ModStates, ModState, SearchDesc,⓪0SplitModName, ModLoaded, MarkState, Criterion, PtrBSS,⓪0FreeMod, ExecProcess, CreateBasePage, ModHeader;⓪ ⓪ FROM Lists IMPORT ResetList, NextEntry, AppendEntry, RemoveEntry,⓪(FindEntry, List, LDir;⓪ ⓪ FROM Paths IMPORT SearchFile, ListPos;⓪ FROM PathCtrl IMPORT PathList;⓪ ⓪ FROM MOSConfig IMPORT LoaderMsg, MaxModExec;⓪ ⓪ FROM Directory IMPORT MakeFullPath;⓪ FROM FileNames IMPORT FileSuffix, SplitName, FilePrefix, SplitPath;⓪ IMPORT FileNames;⓪ ⓪ FROM SysInfo IMPORT UseStackFrame, CPU;⓪ FROM MOSSupport IMPORT ToSuper, ToUser;⓪ IMPORT XBRA;⓪ IMPORT Block;⓪ ⓪ (*⓪"FROM Terminal IMPORT WriteLn, WriteString, Read, Write;⓪ *)⓪ ⓪ CONST Trace = FALSE;⓪&Trace0 = FALSE; (* Prg Start *)⓪&Trace2 = FALSE; (* release *)⓪&Trace3 = FALSE; (* init *)⓪ ⓪ (*$ ? Trace OR Trace0 OR Trace2 OR Trace3:⓪"VAR inch: CHAR;⓪ *)⓪ ⓪ CONST⓪#MaxModNest = 15;⓪'anykey = 0L; (* Joker fuer Modul-Key *)⓪ ⓪&Kennung = "MM2L";⓪ ⓪ TYPE tCallPtr = [0..MaxModNest];⓪ ⓪ ⓪'ExecCondition = (ExecAlways, ExecNever, ExecNew);⓪'⓪'ArgStr = ARRAY [0..127] OF CHAR;⓪&FileStr = ARRAY [0..141] OF CHAR;⓪ ⓪ VAR⓪&CallPtr: tCallPtr;⓪$ChainName: ARRAY tCallPtr OF FileStr;⓪%ChainArg: ARRAY tCallPtr OF ArgStr;⓪ ⓪$error, ok: BOOLEAN;⓪ ⓪&ExecPtr: CARDINAL;⓪%ExecList: POINTER TO ARRAY [0..5000] OF ModRef;⓪ ⓪ (* das geht nun über msr2:⓪"PROCEDURE willBeInit (ref0:ModRef):BOOLEAN;⓪$(*$L-*)⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.W ExecPtr,D0⓪(MOVE.L ExecList,A0⓪(MOVE.L -(A3),D1⓪(BRA c⓪&l CMP.L (A0)+,D1⓪&c DBEQ D0,l⓪(SEQ D0⓪(ANDI #1,D0⓪(MOVE D0,(A3)+⓪&END⓪$END willBeInit;⓪$(*$L=*)⓪ *)⓪ ⓪ PROCEDURE markForInit (ref0: ModRef): BOOLEAN;⓪"BEGIN⓪$(*$ ? Trace3: WriteLn; WriteString (ref0^.codeName^); WriteString (' marked for init.'); *)⓪$IF ExecPtr > MaxModExec THEN⓪&RETURN FALSE⓪$ELSE⓪&ExecList^[ExecPtr]:= ref0; inc (ExecPtr);⓪&RETURN TRUE⓪$END⓪"END markForInit;⓪ ⓪ ⓪ VAR enterFailed: BOOLEAN;⓪ ⓪ PROCEDURE enterMods (open, child: BOOLEAN; VAR exitcode: INTEGER);⓪"(* jedes Modul vorbereiten, ggf. VarSpace retten/löschen *)⓪"VAR execThis: CARDINAL; ad: PtrBSS;⓪"BEGIN⓪$IF open & NOT child THEN⓪&(* wir sind der letzte Env-Handler *)⓪&execThis:= 0;⓪&WHILE execThis < ExecPtr DO⓪(WITH ExecList^[execThis]^ DO⓪*IF ~(initialized IN state) THEN⓪,Block.Clear (varRef, varLen)⓪*ELSIF ~(reentrant IN state) & ~(installed IN state) THEN⓪,(* bei nicht-reentrant-fähigen Modulen wird das alte BSS gerettet⓪-* und dann der BSS-Bereich wie üblich gelöscht *)⓪,(*$ ? Trace: WriteLn; WriteString (codename^); WriteString (' gets new BSS'); *)⓪,ALLOCATE (ad, varLen + 4L);⓪,IF ad = NIL THEN⓪.enterfailed:= TRUE;⓪.exitcode:= -39; (* out of mem *)⓪.RETURN⓪,END;⓪,Block.Copy (varRef, varLen, ADDRESS(ad) + 4L);⓪,ad^.prev:= prevBSS;⓪,prevBSS:= ad;⓪,Block.Clear (varRef, varLen)⓪*END;⓪(END;⓪(INC (execThis);⓪&END;⓪&enterfailed:= FALSE;⓪$END⓪"END enterMods;⓪ ⓪ ⓪ PROCEDURE Fopen ( REF fname: ARRAY OF CHAR; mode : Cardinal;⓪2VAR handle : Cardinal; VAR ior : Integer ) : Boolean;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE mode(A6),-(A7)⓪(MOVE.L fname(A6),-(A7)⓪(MOVE #$3D,-(A7)⓪(TRAP #1⓪(ADDQ.L #8,A7⓪(CLR D1⓪(TST.L D0⓪(BMI err⓪(MOVE D0,D1⓪(CLR D0⓪"err MOVE.L ior(A6),A0⓪(MOVE D0,(A0)⓪(MOVE.L handle(A6),A0⓪(MOVE D1,(A0)⓪$END;⓪$RETURN ior = 0⓪"END Fopen;⓪ ⓪ PROCEDURE Fseek (handle:Cardinal; n:LongCard; mode:Cardinal; VAR p:Longword);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE mode(A6),-(A7)⓪(MOVE handle(A6),-(A7)⓪(MOVE.L n(A6),-(A7)⓪(MOVE #$42,-(A7)⓪(TRAP #1⓪(ADDA.W #10,A7⓪(MOVE.L p(A6),A0⓪(MOVE.L D0,(A0)⓪$END;⓪"END Fseek;⓪ ⓪ PROCEDURE Fclose (handle:Cardinal);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE handle(A6),-(A7)⓪(MOVE #$3E,-(A7)⓪(TRAP #1⓪(ADDQ.L #4,A7⓪$END⓪"END Fclose;⓪ ⓪ PROCEDURE Fread (handle:Cardinal; p: Address; l:LongInt): LONGINT;⓪"VAR res: LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L p(A6),-(A7)⓪(MOVE.L l(A6),-(A7)⓪(MOVE handle(A6),-(A7)⓪(MOVE #$3F,-(A7)⓪(TRAP #1⓪(ADDA.W #12,A7⓪(MOVE.L D0,res(A6)⓪$END;⓪$RETURN res⓪"END Fread;⓪ ⓪ ⓪ PROCEDURE ldHead (handle: CARDINAL;⓪2VAR mlen: LONGCARD;⓪2VAR mid: BYTE;⓪2VAR loadres: LoaderResults);⓪"VAR chead: RECORD⓪/id: ARRAY [0..7] OF CHAR;⓪/layout: BYTE;⓪/modId: BYTE;⓪/res: ARRAY [1..8] OF BYTE;⓪/modlen: LONGCARD;⓪-END;⓪&l: LONGINT; modId2: CARDINAL;⓪"BEGIN⓪$l:= Fread (handle, ADR (chead), SIZE (chead));⓪$IF l < 0L THEN⓪&loadres := badFile;⓪$ELSE⓪&modId2:= ORD (chead.modId) MOD 16;⓪&IF (Compare ("MM2Code", chead.id) # equal)⓪&OR (ORD(chead.layout)>15)⓪&OR ( (modId2#1) & (modId2#2) ) THEN⓪(loadres:= badLayout;⓪&ELSE⓪(loadres:= noError;⓪(mlen:= chead.modlen;⓪(mid:= chead.modId⓪&END⓪$END;⓪"END ldHead;⓪ ⓪ ⓪ PROCEDURE IsModule ( REF fileName: ARRAY OF CHAR ): BOOLEAN;⓪"VAR handle: CARDINAL; ior: INTEGER; r: BOOLEAN; res: LoaderResults;⓪&lc: LONGCARD; b: BYTE;⓪"BEGIN⓪$IF Fopen (fileName,0,handle,ior) THEN⓪&ldHead (handle, lc, b, res);⓪&r:= res = noError;⓪&Fclose (handle)⓪$ELSE⓪&r:= FALSE⓪$END;⓪$RETURN r⓪"END IsModule;⓪ ⓪ ⓪ PROCEDURE SetChain ( REF ModName, Arg : ARRAY OF Char );⓪"(*⓪#* Modul fuer Chaining vormerken⓪#*)⓪"BEGIN⓪$Assign (ModName, ChainName [CallPtr],ok);⓪$Copy (arg,0,127,ChainArg [CallPtr],ok);⓪"END SetChain;⓪ ⓪ ⓪ PROCEDURE prgLoad (REF n:ARRAY OF CHAR): LONGINT;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(CLR.L -(A7) ; Environment⓪(MOVE.L A7,-(A7) ; Cmd-Line: Zeigt auf Leerstring⓪(SUBQ.L #2,A3⓪(MOVE.L -(A3),-(A7) ; Name des Prg.⓪(MOVE #3,-(A7) ; Load-Cmd⓪(MOVE #$4B,-(A7) ; Pexec()⓪(TRAP #1⓪(ADDA.W #16,A7⓪(MOVE.L D0,(A3)+⓪$END⓪"END prgLoad;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE SetMsg (n: CARDINAL; VAR s: ARRAY OF CHAR);⓪"BEGIN⓪$IF LoaderMsg # NIL THEN⓪&Assign (LoaderMsg^[n], s, ok);⓪$END⓪"END SetMsg;⓪ ⓪ PROCEDURE checkExecRes (execRes: INTEGER; VAR myRes: LoaderResults;⓪9REF name: ARRAY OF CHAR; VAR myMsg: ARRAY OF CHAR);⓪"VAR n: CARDINAL;⓪"BEGIN⓪$IF execRes = 0 THEN⓪&myRes:= noError;⓪&myMsg[0]:= ''⓪$ELSE⓪&IF (execRes = -46) OR (execRes = -33) OR (execRes = -34) THEN⓪(myRes:= notFound;⓪(n:= 11⓪&ELSIF (execRes = -39) THEN⓪(myRes:= outOfMemory;⓪(n:= 6⓪&ELSIF (execRes = -66) THEN⓪(myRes:= badLayout;⓪(n:= 4;⓪&ELSE⓪(myRes:= badFile;⓪(n:= 10⓪&END;⓪&SetMsg (n, myMsg);⓪&IF n = 4 THEN⓪(n:= PosLen ('@I',myMsg,0);⓪(Delete (myMsg,n,2,ok);⓪(Insert (FilePrefix(name),n,myMsg,ok);⓪&END⓪$END⓪"END checkExecRes;⓪ ⓪ ⓪ PROCEDURE MovStr (VAR s:ARRAY OF CHAR;d:Longword);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L -10(A3),(A3)+⓪&MOVE.W -10(A3),(A3)+⓪&JSR Length⓪&MOVE.W -(A3),D0⓪&CMPI #127,D0⓪&BLS ok0⓪&MOVEQ #127,D0⓪$ok0⓪&MOVE.L -(A3),A2⓪&SUBQ.L #2,A3⓪&MOVE.L -(A3),A1⓪&MOVE.B D0,(A2)+⓪&BRA cop⓪$clrlp⓪&MOVE.B (A1)+,(A2)+⓪$cop⓪&DBRA D0,clrlp⓪$END⓪"END MovStr;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE Mfree (addr: ADDRESS);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE #$49,-(A7)⓪(TRAP #1⓪(ADDQ.L #6,A7⓪$END⓪"END Mfree;⓪"(*$L=*)⓪ ⓪ PROCEDURE prgUnload (bp:PtrBP);⓪"BEGIN⓪$(* nicht DEALLOCATE verwenden, da sonst u.U. Fehler passieren?! *)⓪$Mfree (bp^.p_env); (* Environment freigeben *)⓪$Mfree (bp) (* TPA / Prg. *)⓪"END prgUnload;⓪ ⓪ PROCEDURE Mshrink (addr: ADDRESS; newAmount: LONGCARD);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE.L -(A3),-(A7)⓪(CLR.W -(A7)⓪(MOVE #$4A,-(A7)⓪(TRAP #1⓪(ADDA.W #12,A7⓪$END⓪"END Mshrink;⓪"(*$L=*)⓪ ⓪ PROCEDURE envLength (env: ADDRESS): LONGCARD;⓪"(* Liefert die Länge eines Environment-Strings *)⓪"VAR (*$Reg*) p: POINTER TO CHAR;⓪"BEGIN⓪$p:= env;⓪$WHILE p^ # 0C DO⓪&REPEAT⓪(INC (p)⓪&UNTIL p^ = 0C;⓪&INC (p)⓪$END;⓪$RETURN ADDRESS (p) - env + 2⓪"END envLength;⓪ ⓪ PROCEDURE CodeSize (bp: PtrBP): LONGCARD;⓪"(* Liefert Länge des statisch belegten Bereichs ohne den Heap-Bonus *)⓪"BEGIN⓪$WITH bp^ DO RETURN 256 + p_tlen + p_dlen + p_blen END⓪"END CodeSize;⓪ ⓪ PROCEDURE prgPrepare (bp:PtrBP; heap:LONGCARD): BOOLEAN;⓪"VAR newlen:LONGCARD; bpsize: LONGCARD;⓪"BEGIN⓪$(* belegter Speicher (TPA): *)⓪$bpsize:= LONGCARD (bp^.p_hitpa) - LONGCARD (bp);⓪$(* benötigter Speicher: *)⓪$newlen:= CodeSize (bp) + heap;⓪$(* Haben wir genug im TPA erhalten? *)⓪$IF newlen > bpsize THEN⓪&prgUnload (bp);⓪&RETURN FALSE⓪$END;⓪$(* TPA verkleinern *)⓪$Mshrink (bp, newlen);⓪$bp^.p_hitpa:= ADDRESS (bp) + newlen;⓪$RETURN TRUE⓪"END prgPrepare;⓪ ⓪ VAR CurrentField, CurrentBasePage: ADDRESS;⓪(TPAOffset: LONGCARD;⓪(GemdosEntry: ADDRESS;⓪(StackFrameOffs: SHORTCARD;⓪(Carrier: XBRA.Carrier;⓪ ⓪ PROCEDURE removeGemdosHdler;⓪"(*⓪#* Trägt den hiesigen GEMDOS-Handler (hdlGemdos) aus.⓪#*)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(LEA Carrier,A2⓪(ADDA.W #12,A2⓪(LEA $84,A0 ; A0: Vektoradr.⓪%l: MOVE.L (A0),A1⓪(CMPA.L A2,A1 ; 'entry' gefunden?⓪(BEQ f⓪(CMPI.L #$58425241,-12(A1) ; Ist dies ein XBRA-Eintrag?⓪(BNE n ; Nein -> Ende⓪(LEA -4(A1),A0 ; Vorige Vektoradr. nach A0⓪(CMPA.L (A0),A1 ; Vektor zeigt auf sich selbst?⓪(BEQ n⓪(BRA l⓪%f: MOVE.L -4(A1),(A0) ; Entry.old eintragen⓪%n:⓪$END;⓪"END removeGemdosHdler;⓪"(*$L=*)⓪ ⓪ PROCEDURE hdlGemdos;⓪ (*⓪!* Diese Funktion hängt im GEMDOS-TRAP-Handler und wartet darauf, daß⓪!* das über 'CallProgram' gestartete Programm die 'Mshrink'-Funktion⓪!* aufruft. Dann wird daraus die benötigte Heap-Größe ermittelt und⓪!* diese Funktion wieder ausgehängt.⓪!*)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(BTST.B #5,(A7) ; War Supervisormode aktiv ?⓪(BNE.B super ; Ja, dann stehen Arg. auf SSP⓪(MOVE.L USP,A0⓪(CMPI.W #$4A,(A0) ; Mshrink - Funktion ?⓪(BEQ.B hdlMshrinkUser⓪ dos ; normale GEMDOS-Funktion ausführen⓪(MOVE.L GemdosEntry,A0⓪(MOVE.L -4(A0),A0⓪(JMP (A0)⓪ super MOVE.W StackFrameOffs,D0 ; damit es auch mit einer 68010/20/30 geht⓪(CMPI.W #$4A,6(A7,D0.W) ; Mshrink - Funktion ?⓪(BNE.B dos ; Nein -> GEMDOS aufrufen⓪(LEA 6(A7,D0.W),A0 ; Basis d. Argumente nach A0⓪ hdlMshrinkUser⓪(MOVE.L 4(A0),A1 ; Argument 'addr' von Mshrink (addr, newamount)⓪(CMPA.L CurrentBasePage,A1 ; ist es die TPA des gesuchten Programms?⓪(BNE dos⓪(MOVE.L 8(A0),D0 ; 'newamount'-Parm von Mshrink: neue TPA-Größe⓪(MOVE.L D0,D1⓪(ADD.L A1,D0⓪(CMP.L 4(A1),D0 ; newamout > p_hitpa (alte TPA-Größe)?⓪(BHI noNewHi ; dann ist zu wenig Speicher da⓪(MOVE.L D0,4(A1) ; p_hitpa in Base Page neu setzen⓪ noNewHi⓪ (*⓪(TST.L UsedHeapSize⓪(BPL ignore ; Heap-Größe wurde bereits ermittelt⓪(SUB.L TPAOffset,D1 ; Subtr. die Größe des stat. Bereichs ohne Heap⓪(MOVE.L D1,UsedHeapSize ; Das ist die gesuchte Heap-Größe⓪(MOVE.L CurrentField,A0⓪(MOVE.L D1,PrgEntry.neededHeapSize(A0)⓪(CMP.L PrgEntry.currentHeapSize(A0),D1⓪(BCC ignore⓪(MOVE.L D1,PrgEntry.currentHeapSize(A0)⓪ ignore⓪ *)⓪(; Diese Routine kann nun aus dem GEMDOS-TRAP entfernt werden⓪(JSR removeGemdosHdler⓪(BRA dos ; Nun lassen wir endlich Mshrink ausführen⓪$END⓪"END hdlGemdos;⓪"(*$L=*)⓪ ⓪ PROCEDURE prgExec (bp:PtrBP; name: ADDRESS; REF arg: ArgStr;⓪3env: ADDRESS; VAR res: INTEGER): BOOLEAN;⓪"(*⓪#* geladenes, gelinktes Programm starten⓪#*)⓪ ⓪"VAR el, dl: LONGCARD; envcopy, hitpa, data: ADDRESS;⓪ ⓪"BEGIN⓪$dl:= bp^.p_dlen + 128L; (* Länge des zu rettenden Data/Basepage-Bereichs *)⓪$ALLOCATE (data,dl);⓪$IF data = NIL THEN⓪&RETURN FALSE⓪$END;⓪$Block.Copy (bp,128,data);⓪$Block.Copy (bp^.p_dbase,bp^.p_dlen,data+128L);⓪$Block.Clear (bp^.p_bbase, bp^.p_hitpa - bp^.p_bbase);⓪ ⓪$(* Environment kopieren, da Pexec dies wie so vieles *⓪%* beim Nur-Starten fälschlicherweise nicht tut. *)⓪$⓪$IF env # 0 THEN⓪&el:= envLength (env);⓪&ALLOCATE (envcopy, el);⓪&IF envcopy = NIL THEN⓪(RETURN FALSE⓪&END;⓪&Block.Copy (env, el, envcopy);⓪&bp^.p_env:= envcopy; (* p_env wird am Ende wg. ganzer BP restauriert *)⓪$END;⓪ ⓪$Block.Copy (CADR(arg),128,ADR(bp^.cmdline));⓪$(*$?Trace0:Write('4');Read(inch);IF Inconsistent() THEN HALT END;*)⓪$ASSEMBLER⓪(MOVE.L bp(A6),A0⓪(⓪(; Pfade v. Parent übernehmen⓪(MOVE.L ProcessID,A2⓪(MOVE.L (A2),A2⓪(MOVE.B $37(A2),$37(A0) ; Default-Drive⓪(MOVEQ #7,D0 ; 16 Pfade (Bytes-Handles)⓪(LEA $40(A0),A1⓪(LEA $40(A2),A2⓪&lll:⓪(MOVE.W (A2)+,(A1)+⓪(DBRA D0,lll⓪(⓪(; DTA auf Cmdline⓪(MOVE.L A0,A1⓪(ADDA.W #128,A1⓪(MOVE.L A1,PtrBP.p_dta(A0)⓪$END;⓪ ⓪$(* 'hdlGemdos' in TRAP #1 einhängen *)⓪$XBRA.Create (Carrier, Kennung, ADDRESS (hdlGemdos), GemdosEntry);⓪$XBRA.Install (GemdosEntry, $84);⓪ ⓪$(* Prozeß starten *)⓪$TPAOffset:= CodeSize (bp);⓪$CurrentBasePage:= bp;⓪$ASSEMBLER⓪(; GEMDOS.Pexec (4, filename, bp, env, exitcode);⓪(MOVE.L env(A6),-(A7) ; unused⓪(MOVE.L bp(A6),-(A7) ; ^basepage⓪(MOVE.L name(A6),-(A7) ; unused, f. Kompatibilität: ^path⓪(MOVE #4,-(A7) ; Exec-Cmd⓪(MOVE #$4B,-(A7) ; Pexec()⓪(TRAP #1⓪(ADDA.W #16,A7⓪(MOVE.L res(A6),A0⓪(MOVE.W D0,(A0)⓪$END;⓪$CurrentBasePage:= NIL;⓪ ⓪$(* 'hdlGemdos' wieder aushängen *)⓪$ASSEMBLER⓪(PEA removeGemdosHdler⓪(JSR CallSuper⓪(ADDQ.L #4,A7⓪$END;⓪$⓪$IF env # 0 THEN⓪&DEALLOCATE (envcopy, 0) (* Kopie vom Environment wieder freigeben *)⓪$END;⓪ ⓪$(*$?Trace0:Write('5');Read(inch);IF Inconsistent() THEN HALT END;*)⓪$hitpa:= bp^.p_hitpa;⓪$Block.Copy (data,128,bp);⓪$bp^.p_hitpa:= hitpa;⓪$Block.Copy (data+128L,bp^.p_dlen,bp^.p_dbase);⓪$DEALLOCATE (data, 0L);⓪$RETURN TRUE⓪"END prgExec;⓪ ⓪ (*⓪ PROCEDURE tosPrg (VAR mname:ARRAY OF Char): BOOLEAN;⓪"VAR sfx: SfxStr; i:CARDINAL;⓪"BEGIN⓪$sfx:= FileSuffix (mname);⓪$IF sfx[0] # 0C THEN⓪&Upper (sfx);⓪&FOR i:=1 TO NoOfPrgSfx DO⓪(IF StrEqual (PrgSfx [i], sfx) THEN⓪*RETURN TRUE⓪(END⓪&END⓪$END;⓪$RETURN FALSE⓪"END tosPrg;⓪ *)⓪ ⓪ MODULE loader0;⓪ ⓪ IMPORT ASSEMBLER, ExecList, ExecPtr, ModRef, TermProcess, Block,⓪'Monitor, ModState, ADDRESS, ModEntry (*, ModUtil2 *),⓪'CPU, ToSuper, ToUser;⓪ ⓪ EXPORT initMods;⓪ ⓪ PROCEDURE execBody (mod0: ModRef; mon: ADDRESS);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L -(A3),D0⓪&MOVE.L -(A3),A1⓪&MOVEM.L D3-D7/A3-A6,-(A7)⓪ ⓪&PEA modReturn(PC)⓪ ⓪&MOVE.L ModEntry.header(A1),A1⓪&ADDA.L 6(A1),A1 ;Adresse des Rumpfes berechnen⓪&PEA (A1)⓪ ⓪&TST.L D0⓪&BNE moncall⓪&RTS⓪$moncall⓪&MOVE.L D0,A1⓪&JMP (A1)⓪&⓪$modReturn⓪&MOVEM.L (A7)+,D3-D7/A3-A6⓪$END⓪"END execBody;⓪"(*$L=*)⓪ ⓪ PROCEDURE initMods;⓪"VAR execThis: CARDINAL; mod0: ModRef; mon: ADDRESS;⓪"BEGIN⓪$execThis:= 0;⓪$mon:= NIL;⓪$WHILE execThis < ExecPtr DO⓪&mod0:= ExecList^[execThis];⓪&INC (execThis);⓪&WITH mod0^ DO⓪(IF ~(initialized IN state) THEN⓪*INCL (state,initialized);⓪*INCL (state,firstcall);⓪(END;⓪&END;⓪&IF execThis = ExecPtr THEN⓪(mon:= ADDRESS (Monitor);⓪&END;⓪&(* ModUtil2.CallBody (mod0); *)⓪&execBody (mod0, mon);⓪&(* ModUtil2.LeaveBody (mod0); *)⓪&EXCL (mod0^.state,firstcall)⓪$END;⓪"END initMods;⓪ ⓪ END loader0;⓪ ⓪ ⓪ PROCEDURE outerErrHandler (REF name, clientname: ARRAY OF CHAR;⓪;nowImport: BOOLEAN; errtype: LoaderResults;⓪;VAR errmsg: ARRAY OF CHAR);⓪"PROCEDURE get (idx,n:CARDINAL);⓪$BEGIN⓪&SetMsg (idx, errmsg);⓪&IF n#0 THEN⓪(idx:= PosLen ('@I',errmsg,0);⓪(Delete (errmsg,idx,2,ok);⓪(Insert (FilePrefix(name),idx,errmsg,ok);⓪(IF n=2 THEN⓪*idx:= PosLen ('@C',errmsg,0);⓪*Delete (errmsg,idx,2,ok);⓪*Insert (clientname,idx,errmsg,ok);⓪(END⓪&END⓪$END get;⓪"BEGIN⓪$CASE errtype OF⓪&badversion:⓪(get (5,2)|⓪&BadLayout:⓪(get (4,1)|⓪&NotFound:⓪(IF nowImport THEN⓪*get (1,2)⓪(ELSE⓪*get (0,1)⓪(END|⓪&BadFile:⓪(get (2,1)|⓪&BadData:⓪(get (3,1)|⓪&OutOfMemory:⓪(get (6,0)|⓪&denied:⓪(get (7,1)|⓪&initFault:⓪(get (12,0)|⓪&exitFault:⓪(get (13,0)|⓪¬Linkable:⓪(get (14,1)|⓪&wrongRealForm:⓪(get (15,1)|⓪&wrongFPUType:⓪(get (16,1)|⓪&tooManyMods:⓪(get (17,0)|⓪$ELSE HALT⓪$END⓪"END outerErrHandler;⓪ ⓪ (*$X+*)⓪ PROCEDURE FlushCPUCache ();⓪"BEGIN⓪$ASSEMBLER⓪(JSR CPU⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪(MOVE.L -(A3),D0⓪(CMPI.L #68020,D0⓪(BCS ende⓪(CMPI.L #68040,D0⓪(BCS fl30⓪(NOP⓪(DC.W $F4F8 ; CPUSHA BC⓪(BRA ende⓪"fl30: MOVEC CACR,D0⓪(ORI #$0808,D0⓪(MOVEC D0,CACR⓪"ende: JSR ToUser⓪(ADDQ.L #4,A7⓪$END⓪"END FlushCPUCache;⓪ (*$X=*)⓪ ⓪ PROCEDURE ExecMod (REF mainName: ARRAY OF CHAR; (* Name des gewuenschten Moduls *)⓪4exec: ExecCondition; (* wann ausfuehren? *)⓪3Paths: PathList;⓪1REF Arg: ArgStr;⓪5env: ADDRESS;⓪,VAR ExitCode: Integer;⓪.VAR ErrMsg: ARRAY OF CHAR;⓪-VAR loadres: LoaderResults)⓪8: ModRef; (* vergebener Index *)⓪8⓪#VAR nowimport: Boolean;⓪'clientname: ModStr;⓪ ⓪"PROCEDURE errHandler (REF name:ARRAY OF CHAR; errtype:loaderresults);⓪$BEGIN⓪&outerErrHandler (name, clientname, nowImport, errtype, errmsg)⓪$END errHandler;⓪ ⓪"PROCEDURE LinkMod (msname: ARRAY OF Char; (* Name des Moduls *)⓪4reqkey: LONGCARD; (* gewuenschter Key *)⓪6exec: ExecCondition; (* wann ausfuehren? *)⓪4client: ModRef) (* Index des Klienten *)⓪:: ModRef; (* vergebener Index *)⓪"⓪"(* Laedt das Modul "msname" und liefert dessen Index in der "ModLst"⓪#* als Ergebnis.⓪#* Der Modulkey "reqkey" wird erwartet und ueberprueft;⓪#* Falls ein Fehler beim Relozieren oder Laden auftritt,⓪#* wird der benoetigte Speicher freigegeben und als Ergebnis⓪#* "NIL" geliefert⓪#*)⓪$⓪$VAR newname: FileStr;⓪"⓪$PROCEDURE MakeImpList (ref0:ModRef); (* Importliste erstellen *)⓪&⓪&PROCEDURE getImport (VAR p:ADDRESS; VAR name: ARRAY OF CHAR): BOOLEAN;⓪((*$L-*)⓪(BEGIN⓪*ASSEMBLER⓪2MOVE -(A3),D1⓪2MOVE.L -(A3),A0⓪2MOVE.L -(A3),A2⓪2MOVE.L (A2),A1⓪2TST.L (A1)+ ; KEY⓪2BEQ F⓪2; NAMEN HOLEN⓪0L MOVE.B (A1)+,D0⓪2CMPI.B #$FE,D0⓪2BCC E⓪2MOVE.B D0,(A0)+⓪2DBRA D1,L⓪2BRA T⓪0E CLR.B (A0)+⓪2BRA T⓪0M MOVE.B (A1)+,D0⓪0T ADDQ.B #1,D0⓪2BNE M⓪2; ENDE DES NAMENS ERREICHT; LISTENENDE SUCHEN⓪0q TST (A1)+⓪2BEQ O⓪2ADDQ.L #4,A1⓪2BRA q⓪0O MOVE.L A1,(A2)⓪2MOVE #1,(A3)+⓪2RTS⓪0F CLR (A3)+⓪*END⓪(END getImport;⓪((*$L+*)⓪&⓪&VAR implist: ADDRESS;⓪*name: ModStr;⓪*n: CARDINAL;⓪*s: SearchDesc;⓪*⓪&BEGIN (* MakeImpList *)⓪(ASSEMBLER⓪*MOVE.L ref0(A6),A0⓪*MOVE.L modref.header(A0),A1⓪*MOVE.L $E(A1),D0⓪*ADD.L A1,D0⓪*MOVE.L D0,modref.imports(A0)⓪*MOVE.L D0,implist(A6)⓪(END;⓪(n:=0;⓪(WHILE getImport (implist,name) DO⓪*s.mode:= modName;⓪*s.mname:= ADR (name);⓪*GetModRef (s,ref0^.imports^[n]);⓪*INC (n)⓪(END;⓪(ref0^.imports^[n]:= NIL⓪&END MakeImpList;⓪ ⓪$PROCEDURE ReadMod (REF fname: ARRAY OF CHAR;⓪7VAR mname: ARRAY OF CHAR): ModRef;⓪$(*-----------------------------------------------*)⓪$(* Laedt ein Modul in den Speicher, ueberprueft das Format⓪%* und traegt in die Modul-Liste ein. Reloziert nicht!⓪%* Wenn ein Fehler auftritt, wird der benutzte Speicher⓪%* freigegeben und als Modul-Index NIL geliefert.⓪%* 'fname': Dateiname; 'mname': Modulname, wird ggf. korrgiert.⓪%*)⓪&⓪$⓪$TYPE BSET = SET OF [0..7];⓪$⓪$VAR modad: ADDRESS;⓪'maxlen: LongCard;⓪&loadlen,⓪)cend,⓪&headlen,⓪'modlen: LongCard;⓪'cstart: ADDRESS;⓪(cname: POINTER TO ModStr;⓪'cname0: ModStr;⓪'cname1: ModStr;⓪'dummyl,⓪)flen: LongCard;⓪%foundkey: LONGCARD;⓪(found: boolean;⓪(modId: BYTE;⓪'modId3: BSET;⓪%realCode: CARDINAL;⓪'handle: Cardinal;⓪#searchMode: ListPos;⓪*ior: INTEGER;⓪(modst: ModRef;⓪&reenter: BOOLEAN;⓪ ⓪$BEGIN (* ReadMod *)⓪&(*$ ? Trace: WriteLn; WriteString ('ReadMod: '); WriteString (fname); *)⓪&searchMode:= fromStart;⓪&IF nowimport THEN⓪(Assign (mname, cname1, ok);⓪(Upper (cname1);⓪&ELSE⓪((* Pfad entfernen für evtl. Fehlermeldung *)⓪(SplitPath (mname, cname1(*dummy*), mname);⓪&END;⓪&REPEAT⓪(SearchFile (fname,Paths,searchMode,found,newname);⓪(IF ~found THEN⓪*(*$ ? Trace: WriteLn; WriteString ('exit: not found'); *)⓪*loadres:= notfound;⓪*RETURN NIL⓪(END;⓪(searchMode:= fromNext;⓪(⓪(MakeFullPath (newname, ior);⓪(IF ~Fopen (newname,0,handle,ior) THEN⓪*IF (ior = -33) OR (ior = -34) OR (ior = -46) THEN⓪,(*$ ? Trace: WriteLn; WriteString ('exit: not found 2'); *)⓪,loadres:= notfound;⓪*ELSE⓪,(*$ ? Trace: WriteLn; WriteString ('exit: bad file'); *)⓪,loadres:= badFile;⓪*END;⓪*RETURN NIL⓪(END;⓪(⓪(ldHead (handle, modLen, modId, loadres);⓪(IF loadres # noError THEN⓪*Fclose (handle);⓪*RETURN NIL⓪(END;⓪(Fseek (handle,0,2,flen); (* Get length of file *)⓪(Fseek (handle,8,0,dummyl); (* Seek hinter "MM2Code" *)⓪(DEC (flen, 8); (* weil erst ab 8. byte geladen wird *)⓪ ⓪(modId3:= BSET (modId);⓪(ASSEMBLER⓪*MOVE.B modId(A6),D0⓪*LSR.B #5,D0⓪*ANDI.W #3,D0⓪*MOVE.W D0,realCode(A6)⓪(END;⓪ ⓪(IF flen > modlen THEN (* !!! *)⓪*loadlen := flen⓪(ELSE⓪*loadlen := modlen⓪(END;⓪ ⓪(loadLen:= loadLen + TSIZE (ModEntry);⓪ ⓪(SysAlloc (modst, loadlen);⓪(IF modst = NIL THEN⓪*(* ! Eigentlich sollte hier der Fehler noch nicht auftreten, weil⓪+* noch nicht sicher ist, ob dies überhaupt das richtige File ist.*)⓪*(*$ ? Trace:⓪,WriteLn; WriteString ('exit: no memory');⓪**)⓪*Fclose (handle);⓪*loadres:= outofmemory;⓪*RETURN NIL⓪(END;⓪(⓪(modad:= ADDRESS (modst) + TSIZE (ModEntry);⓪(⓪(IF Fread (handle,modad,flen) <= 0L THEN⓪*(*$ ? Trace:⓪,WriteLn; WriteString ('exit: bad file 3');⓪**)⓪*Fclose (handle);⓪*loadres := badFile;⓪*DeAllocate (modst,0L);⓪*RETURN NIL⓪(END;⓪(⓪(Fclose (handle);⓪(⓪(ASSEMBLER⓪*MOVE.L modad(A6),A0⓪*MOVE.L 2(A0),foundkey(A6)⓪*MOVE.L 42(A0),D0⓪*MOVE.L D0,headlen(A6)⓪*ADD.L A0,D0⓪*MOVE.L D0,cstart(A6)⓪*MOVE.L 22(A0),cend(A6)⓪*MOVE.L 46(A0),D0 ; Options laden⓪*BTST #25,D0 ; $Y+? dann ist Modul-Reentry möglich⓪*SNE D0⓪*ANDI #1,D0⓪*MOVE D0,reenter(A6)⓪*MOVE.L 30(A0),D0⓪*ADD.L A0,D0⓪*MOVE.L D0,cname(A6)⓪(END;⓪(cname0:=cname^;⓪(Upper (cname0);⓪&UNTIL ~nowimport OR StrEqual (cname0,cname1);⓪&(*$ ? Trace:⓪(WriteLn; WriteString ('read ok');⓪&*)⓪ ⓪&IF realCode # 0 THEN⓪((*⓪)* Falls das Modul Reals benutzt, muß geprüft werden, ob⓪)* die vorhandenen Libs das richtige Format und die richtigen⓪)* Runtime-Calls unterstützt. Da wir auf jeden Fall Runtime⓪)* eingelinkt haben, können wir pauschal davon ausgehen, da0⓪)* zumindest einer der 3 mögl. Real-Modi gesetzt ist (theoretisch⓪)* gäbe es ja noch den Fall, daß keine der gelinkten Libs Reals⓪)* benutzt und daher das Format noch undefiniert wäre).⓪)*)⓪(IF RealMode # realCode THEN⓪*IF (realCode > 1) & (RealMode > 1) THEN⓪,loadres:= wrongFPUType; (* beides IEEE, aber falsche FPU *)⓪*ELSE⓪,loadres:= wrongRealForm; (* IEEE <-> MM2Reals *)⓪*END;⓪*Fclose (handle);⓪*DeAllocate (modst,0L);⓪*RETURN NIL⓪(END;⓪&END;⓪&⓪&Assign (cname^, mname, ok);⓪&⓪&IF (reqkey#anykey) & (reqkey#foundkey) THEN⓪((*$ ? Trace:⓪*WriteLn; WriteString ('exit: bad version');⓪(*)⓪(loadres := badversion;⓪(DeAllocate (modst,0L);⓪(RETURN NIL⓪&END;⓪&⓪&(* Modul in ModLst eintragen *)⓪&⓪&AppendEntry(ModLst,modst,error);⓪&IF error THEN⓪((*$ ? Trace:⓪*WriteLn; WriteString ('exit: no memory 2');⓪(*)⓪(DeAllocate (modst,0L);⓪(loadres:= outofmemory;⓪(RETURN NIL⓪&END;⓪&WITH modst^ DO⓪(codeName:= ADDRESS (cname);⓪(Assign (cname0,codeNameUp,ok);⓪((*SplitPath (newname, filePath, fn); SplitName (fn, fileName, sfx);*)⓪(fileName:= FilePrefix (newname);⓪(header:= modad;⓪(codeStart:= cstart;⓪(codeLen:= cend-headlen;⓪(varRef:= cend+modad;⓪(varLen:= modlen-cend;⓪(state:= ModStates {};⓪(IF 4 IN modId3 THEN INCL (state, procSym) END;⓪(IF reenter THEN INCL (state, reentrant) END;⓪(imports:= NIL;⓪(prevBSS:= NIL;⓪(IF FullStorBaseAccess () THEN⓪*owner:= NIL⓪(ELSE⓪*owner:= ProcessID^⓪(END⓪&END;⓪&Assign (cname^,clientname,ok);⓪&loadres:= noError;⓪&RETURN modst⓪$END ReadMod;⓪$⓪$⓪$PROCEDURE Relocate ( header: Address;⓪8myIndex: ModRef;⓪;exec: ExecCondition): BOOLEAN;⓪$⓪$VAR Result: Boolean;⓪$⓪$BEGIN⓪&ASSEMBLER⓪,MOVEM.L D3/A4, -(SP) ; !MS D3/A4 retten⓪,CLR.W Result(A6) ;kann nur noch besser werden⓪,MOVE.L header(A6),A4 ;A4 zeigt auf zu relozierendes Modul⓪,MOVE.L 22(A4),A0⓪,ADDA.L A4,A0⓪&!RE3 MOVE.L (A0)+,D0 ;Var/Proc-Liste abarbeiten⓪,BEQ RE1⓪,MOVE.L (A0)+,D1⓪,ADD.L A4,D1⓪&!RE2 MOVE.L 0(A4,D0.L),D2⓪,MOVE.L D1,0(A4,D0.L)⓪,MOVE.L D2,D0⓪,BNE RE2⓪,BRA RE3⓪,⓪&!RE1 MOVE.L 14(A4),A1 ;A1 zeigt auf Import-Liste⓪,ADDA.L A4,A1⓪&!RE5 MOVE.L (A1)+,D0 ;Key des importierten Moduls⓪,BEQ.L RE4 ;keine IMPORTs mehr⓪,⓪,; wir bereiten den Filenamen vor. Zuerstmal auf den A3 Stack⓪,CLR.W D1⓪&!RE13 MOVE.B (A1)+,D2⓪,CMPI.B #$FE,D2 ;statt BMI, damit auf öäü möglich ist.⓪,BCC RE12⓪,MOVE.B D2,(A3)+⓪,ADDQ.W #1,D1⓪,BRA RE13⓪&!RE12 ADDQ.B #1,D2 ;Sync A1⓪,BEQ RE14⓪,ADDQ.L #1,A1⓪&!RE14 CLR.B (A3)+⓪,MOVE.L A3,D2⓪,BTST #0,D2⓪,BEQ nosync⓪,ADDQ #1,D1⓪,ADDQ.L #1,A3⓪%nosync ; nun den Kram aufn A7 Stack⓪,MOVE D1,D2⓪,ADDQ #1,D2⓪,LSR #1,D2⓪,SUBQ #1,D2⓪$trfname MOVE -(A3),-(A7)⓪,DBRA D2,trfname⓪,MOVE.L A7,(A3)+ ;und die Adresse des Strings aufn A3⓪,MOVE.W D1,(A3)+ ;samt dem High-Wert⓪,⓪,MOVE.L D0,(A3)+ ;Key⓪,MOVE.W exec(A6),(A3)+⓪,MOVE.L myIndex(A6),(A3)+ ;myIndex ist klienten-Index⓪,MOVEM.L D1/A4/A1,-(A7)⓪,MOVE.L (A6),A0 ;Dynamic Link fuer ProcCall⓪,MOVE.L (A0),D2⓪,BSR LinkMod⓪,(*$ ? Trace:⓪.END;⓪0Read (inch);⓪.ASSEMBLER⓪,*)⓪,MOVEM.L (A7)+,D1/A4/A1⓪,ADDQ.W #1,D1⓪,ADDA.W D1,A7 ;mname vom Stack runter⓪,MOVE.L -(A3),D0 ;Index des importierten Moduls⓪,BEQ BAD ;da gab's wohl irgendwo einen Fehler⓪,MOVE.L D0,A2⓪,MOVE.L ModEntry.header(A2),A2⓪&!RE6 MOVE.W (A1)+,D0 ;imp. ItemNr⓪,BEQ RE5⓪,MOVE.L 18(A2),D3 ;Offset zur Exp.liste⓪,BEQ BAD ;keine da⓪,ADD.L A2,D3⓪,MOVE.L (A1)+,D1 ;importiertes Item⓪,BEQ RE6⓪,MOVE.L D3,A0⓪&!RE9 MOVE.W (A0)+,D2 ;Item in Exportliste suchen⓪,BEQ BAD⓪,CMP.W D2,D0⓪,BEQ RE10⓪,ADDQ.L #4,A0⓪,BRA RE9⓪&!RE10 MOVE.L (A0)+,D2 ;abs. ItemAdr ausrechnen⓪,ADD.L A2,D2⓪&!RE11 MOVE.L 0(A4,D1.L),D0 ;ItemAdr im Modul nachtragen⓪,MOVE.L D2,0(A4,D1.L)⓪,MOVE.L D0,D1⓪,BNE RE11⓪,BRA RE6⓪&!RE4 MOVE.W #1,Result(A6) ;alles klar⓪&!BAD MOVEM.L (SP)+, D3/A4 ; !MS Register restaurieren⓪&END;⓪&FlushCPUCache ();⓪&RETURN Result⓪$END Relocate;⓪"⓪"PROCEDURE PrepareExec (ref0:ModRef; mustBeDeInit:BOOLEAN): BOOLEAN;⓪$(*⓪%* Bereitet das geladene Modul und ggf. seine zu initialisierenden⓪%* Importe auf ein Init vor.⓪%* mustBeDeInit: "Modul muß deinit. sein, um gestartet werden zu dürfen"⓪%*)⓪$VAR j: POINTER TO ModRef;⓪$BEGIN⓪&WITH ref0^ DO⓪(INCL (state, msr1);⓪(IF ~(initialized IN state) (* noch nicht init.? *)⓪(OR ~mustBeDeInit & (installed IN state) (* oder installed? *) THEN⓪*(*⓪+* Da das Modul noch nicht init. ist, wird es dafür vorgemerkt.⓪+* Zuvor müssen aber noch seine Importe geprüft werden:⓪+*)⓪*IF imports # NIL THEN⓪,j:= ADDRESS (imports);⓪,LOOP⓪.IF j^=NIL THEN EXIT END;⓪.IF NOT (msr1 IN j^^.state) THEN⓪0IF NOT PrepareExec (j^, TRUE) THEN RETURN FALSE END⓪.END;⓪.INC (j, 4)⓪,END⓪*END;⓪*(*$ ? Trace OR Trace3: WriteLn; WriteString (codename^); WriteString (' will be executed'); *)⓪*IF NOT (msr2 IN ref0^.state) THEN⓪,INCL (ref0^.state, msr2);⓪,IF NOT markForInit (ref0) THEN⓪.loadRes:= tooManyMods;⓪.errHandler (mainName,loadRes);⓪.RETURN FALSE⓪,END;⓪*END⓪(END;⓪&END;⓪&RETURN TRUE⓪$END PrepareExec;⓪"⓪"VAR fname : FileStr;⓪&execRel: ExecCondition;⓪&ref0: ModRef;⓪&basepage: PtrBP;⓪&ior: INTEGER;⓪&ploadres: LONGINT;⓪&found: BOOLEAN;⓪&fn: NameStr;⓪&sfx: ARRAY [0..2] OF CHAR;⓪ ⓪"PROCEDURE prgInstall (): BOOLEAN;⓪$VAR err: BOOLEAN;⓪$BEGIN⓪&SysAlloc (ref0,TSIZE (ModEntry));⓪&IF ref0 # NIL THEN⓪(Block.Clear (ref0,SIZE(ref0^));⓪(AppendEntry(ModLst,ref0,err);⓪&ELSE⓪(err:= TRUE;⓪&END;⓪&RETURN ~err⓪$END prgInstall;⓪ ⓪"BEGIN (* of LinkMod *)⓪$FlushCPUCache ();⓪$(*$ ? Trace: WriteLn; WriteString ('LinkMod: '); WriteString (msname); *)⓪$IF client # NIL THEN⓪&clientname := client^.codename^⓪$END;⓪$⓪$IF ModLoaded (msname,nowimport,fname,ref0) THEN⓪&(*$ ? Trace: WriteString (', already in RAM, '); *)⓪&WITH ref0^ DO⓪(IF program IN state THEN⓪*(*$ ? Trace: WriteString (' is program'); *)⓪*RETURN ref0⓪(ELSIF (reqkey#anykey) & (reqkey#header^.key) THEN⓪*(*$ ? Trace: WriteString ('bad version'); *)⓪*loadres := badversion;⓪*errHandler (codeName^,badversion);⓪*RETURN NIL⓪(ELSE (* tatsaechlich: wir haben das richtige Modul im RAM *)⓪*(*$ ? Trace: WriteString ('version ok.'); *)⓪*IF exec = execAlways (* zu startendes Hauptmodul *) THEN⓪,IF (installed IN state) OR ~(initialized IN state) THEN⓪.IF NOT (msr1 IN state) THEN⓪0IF NOT PrepareExec (ref0, FALSE) THEN⓪2RETURN NIL⓪0END⓪.END⓪,ELSE⓪.(*$ ? Trace: WriteLn; WriteString ('error: already initialized !'); *)⓪.loadres := denied;⓪.errHandler (codeName^,denied);⓪.RETURN NIL⓪,END⓪*ELSIF exec = execNew (* importiertes, bereits nachgeladenes Modul *) THEN⓪,IF NOT (msr1 IN state) THEN⓪.IF NOT PrepareExec (ref0, TRUE) THEN⓪0RETURN NIL⓪.END⓪,END⓪*END;⓪*RETURN ref0⓪(END⓪&END⓪$END;⓪$⓪$(*⓪%* Hier kommen wir an, wenn Modul nicht im RAM liegt⓪%*)⓪$⓪$IF Empty (FilePrefix (fname)) THEN⓪&(* ungültiger Modul-/Dateiname *)⓪&loadres:= notfound;⓪&SetMsg (8, errmsg);⓪&RETURN NIL⓪$END;⓪$⓪$ref0 := ReadMod (fname, msname);⓪$(*$ ? Trace: Read (inch); *)⓪$IF ref0 # NIL THEN (* Load war erfolgreich *)⓪&(*$ ? Trace: WriteLn; WriteString (msname); WriteString (': load ok'); *)⓪&nowimport:= True;⓪&IF exec = execNever THEN execRel:= execNever ELSE execRel:= execNew END;⓪&(*⓪'* Wir müssen hier schon das Modul markieren, weil sonst bei⓪'* zirkulären Importen dies Modul zu früh init. würde (z.B. beim⓪'* Compiler)⓪'*)⓪&INCL (ref0^.state, msr2);⓪&IF Relocate (ref0^.header, ref0, execRel) THEN⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': relocate ok, '); *)⓪(MakeImpList (ref0);⓪(IF exec # execNever THEN⓪*(*$ ? Trace: WriteString ('will be executed.'); *)⓪*IF NOT markForInit (ref0) THEN⓪,loadRes:= tooManyMods;⓪,errHandler (mainName,loadRes);⓪,Release (ref0,FALSE,FALSE);⓪,RETURN NIL⓪*END⓪(END;⓪(WITH ref0^ DO⓪*Loading (codeName^,newName,codeStart,codeLen,varRef,varLen);⓪(END;⓪(RETURN ref0⓪&ELSE (* Relocate ist schiefgegangen *)⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': relocate error'); *)⓪(IF loadRes = noError THEN⓪*loadRes:= notLinkable;⓪*errHandler (ref0^.codeName^,loadRes)⓪(END;⓪(MakeImpList (ref0); (* damit alle imp. Module wieder freigegb. werden*)⓪(Release (ref0,FALSE,FALSE);⓪(RETURN NIL⓪&END;⓪$ELSE (* Load ist schiefgegangen *)⓪&IF loadres # badLayout THEN⓪((*$ ? Trace: WriteLn; WriteString (msname); WriteString (': load error'); *)⓪(errHandler (msname,loadres);⓪(RETURN NIL⓪&ELSE⓪((* ...dann müßte es ein TOS-Prg sein *)⓪((*$ ? Trace: WriteString (', loading program.'); *)⓪(ploadres:= prgLoad (newname);⓪(IF ploadres < 0L THEN⓪*checkExecRes (SHORT (ploadres), loadRes, msname, errmsg);⓪*RETURN NIL⓪(ELSE⓪*errMsg[0]:=0C;⓪*basepage:= PtrBP (ploadres);⓪*IF prgPrepare (basepage, DefaultStackSize) & prgInstall() THEN⓪,WITH ref0^ DO⓪.(*SplitPath (newname, filePath, fn); SplitName (fn, fileName, sfx);*)⓪.fileName:= FilePrefix (newname);⓪.Assign (fileName, codeNameUp, ok); (* geht, weil fileName ohne Sfx*)⓪.codeName:= ADR (codeNameUp);⓪.codeStart:= basepage;⓪.header:= codeStart;⓪.codeLen:= basepage^.p_tlen;⓪.state:= ModStates {mainMod,program};⓪.owner:= ProcessID^;⓪.Loading (codeNameUp,newname,codeStart,codeLen,NIL,0L)⓪,END;⓪,loadRes:= NoError;⓪,RETURN ref0⓪*ELSE⓪,DEALLOCATE (ref0,0L);⓪,prgUnload (basepage);⓪,loadRes:= outOfMemory;⓪,errHandler (newname,loadRes);⓪,RETURN NIL⓪*END⓪(END⓪&END⓪$END (* IF tosPrg ... ELSE *)⓪"END LinkMod;⓪ ⓪"VAR DTA: ARRAY [1..22] OF WORD;⓪&basepage: PtrBP;⓪&stacksize: LONGCARD;⓪ ⓪"PROCEDURE exitMods;⓪$(* alten VarSpace wiederherstellen *)⓪$VAR execThis: CARDINAL; ad: PtrBSS;⓪$BEGIN⓪&execThis:= 0;⓪&WHILE execThis < ExecPtr DO⓪(WITH ExecList^[execThis]^ DO⓪*IF prevBSS # NIL THEN⓪,(*$ ? Trace: WriteLn; WriteString (codename^); WriteString (' restores BSS'); *)⓪,ad:= prevBSS;⓪,prevBSS:= prevBSS^.prev;⓪,Block.Copy (ADDRESS(ad) + 4L, varLen, varRef);⓪,DEALLOCATE (ad, 0);⓪*END;⓪(END;⓪(INC (execThis);⓪&END;⓪$END exitMods;⓪ ⓪"PROCEDURE initPrgSpace (prgFlags: LONGWORD) : Boolean;⓪$BEGIN⓪&(*$ ? Trace: WriteLn; WriteString ('CreatePB'); *)⓪&IF ~CreateBasePage (basepage, stacksize, CADR (mainName), prgFlags) THEN⓪(basepage:= NIL;⓪(RETURN FALSE⓪&END;⓪&Block.Copy (CADR(arg),128,ADR(basepage^.cmdline));⓪&basepage^.p_dta:= ADR(DTA);⓪&(*$ ? Trace: WriteString (' ok.'); *)⓪&RETURN true⓪$END initPrgSpace;⓪ ⓪"PROCEDURE removePrgSpace;⓪$BEGIN⓪&IF basepage # NIL THEN⓪((* nicht DEALLOCATE verwenden, da sonst u.U. Fehler passieren?! *)⓪(Mfree (basepage^.p_env);⓪(Mfree (basepage)⓪&END;⓪$END removePrgSpace;⓪"⓪"PROCEDURE outOfMem;⓪$BEGIN⓪&loadres := outofmemory;⓪&errHandler ('',loadres);⓪$END outOfMem;⓪"⓪"PROCEDURE reset (st: ModStates); (* Flags 'msr1' & 'msr2' löschen *)⓪$VAR i: ModRef;⓪$BEGIN⓪&ResetList (ModLst);⓪&LOOP⓪(i:= NextEntry (ModLst);⓪(IF i=NIL THEN EXIT END;⓪(i^.state:= i^.state - st⓪&END⓪$END reset;⓪ ⓪"PROCEDURE initNonReentrants (): BOOLEAN;⓪$(*⓪%* Es reicht nicht aus, in PrepareExec() alle Importe zum Init. zu prüfen.⓪%* Denn es kann vorkommen, daß z.B. über Treiber weitere Module abhängig⓪%* sind. Zwar sind diese schon initialisiert, wenn sie jedoch nicht⓪%* reentrant sind, müssen sie erneut init. werden.⓪%* Dies sollte darüber funktionieren, daß die Driver-Liste ausgewertet⓪%* wird. Solange dies noch nicht impl. ist, muß anders vorgegangen⓪%* werden:⓪%* Es werden zur Sicherheit einfach alle Module init., die schon⓪%* initialisiert & non-reentrant $ ~mainMod sind. Damit werden u.U.⓪%* zwar mehr Module als nötig init, das sollte aber nicht schaden.⓪%*)⓪$⓪$PROCEDURE check (i: ModRef): BOOLEAN;⓪&VAR j: POINTER TO ModRef;⓪&BEGIN⓪(WITH i^ DO⓪*INCL (state, msr1);⓪*IF imports # NIL THEN⓪,j:= ADDRESS (imports);⓪,LOOP⓪.IF j^ = NIL THEN EXIT END;⓪.IF NOT (msr1 IN j^^.state) THEN⓪0IF NOT check (j^) THEN RETURN FALSE END⓪.END;⓪.INC (j, 4)⓪,END⓪*END;⓪*IF NOT (reentrant IN state) & (initialized IN state)⓪*& NOT (mainMod IN state)⓪*& NOT (installed IN state) THEN⓪,IF NOT (msr2 IN i^.state) THEN⓪.INCL (i^.state, msr2);⓪.(*$ ? Trace OR Trace3: WriteLn; WriteString (codename^); WriteString (' will be executed'); *)⓪.IF NOT markForInit (i) THEN RETURN FALSE END⓪,END⓪*END⓪(END;⓪(RETURN TRUE⓪&END check;⓪$⓪$VAR i: ModRef;⓪$⓪$BEGIN⓪&ResetList (ModLst);⓪&LOOP⓪(i:= NextEntry (ModLst);⓪(IF i=NIL THEN EXIT END;⓪(IF NOT (msr1 IN i^.state) THEN⓪*IF NOT check (i) THEN⓪,RETURN FALSE⓪*END⓪(END⓪&END;⓪&RETURN TRUE⓪$END initNonReentrants;⓪ ⓪"VAR usedIndex: ModRef; lastExecPtr, termState: CARDINAL;⓪&ehdl: EnvlpCarrier;⓪&initOK: BOOLEAN; lastExecList: ADDRESS;⓪ ⓪ BEGIN (* ExecMod *)⓪"(*$?Trace0:Write('1');Read(inch);IF Inconsistent() THEN HALT END;*)⓪"errMsg[0]:=0C;⓪"loadres := noError;⓪"lastExecList:= ExecList;⓪"lastExecPtr:= ExecPtr;⓪"ALLOCATE (ExecList, (MaxModExec+1)*SIZE (ExecList^[0]));⓪"usedIndex:= NIL;⓪"IF ExecList = NIL THEN⓪$outOfMem⓪"ELSE⓪$ExecPtr := 0;⓪$nowimport := False;⓪$clientname:= '';⓪$IF exec # execNever THEN⓪&reset (ModStates{msr1,msr2});⓪&initOK:= initNonReentrants ();⓪&reset (ModStates{msr1})⓪$ELSE⓪&initOK:= TRUE⓪$END;⓪$IF initOK THEN⓪&usedIndex := LinkMod (mainName, anykey, exec, NIL);⓪&IF exec # execNever THEN reset (ModStates{msr1,msr2}) END;⓪&(*$ ? Trace OR Trace3: Read (inch); *)⓪&(*$?Trace0:Write('2');Read(inch);IF Inconsistent() THEN HALT END;*)⓪&IF usedIndex # NIL THEN⓪(INCL (usedIndex^.state, mainMod);⓪(IF program IN usedIndex^.state THEN⓪*(*$?Trace0:Write('3');Read(inch);IF Inconsistent() THEN HALT END;*)⓪*IF exec # ExecNever THEN⓪,IF NOT prgExec (usedIndex^.codeStart, CADR (mainName), arg, env, exitCode) THEN⓪.outOfMem⓪,END;⓪,(*$?Trace0:Write('6');Read(inch);IF Inconsistent() THEN HALT END;*)⓪*END⓪(ELSIF ExecPtr > 0 THEN⓪*stacksize:= usedIndex^.header^.stackSize;⓪*IF stacksize = 0 THEN⓪,stacksize := Defaultstacksize⓪*END;⓪*IF stacksize < 1024L THEN stacksize := 1024 END;⓪*IF odd (stacksize) THEN dec (stacksize) END;⓪*(*$ ? Trace: WriteLn; WriteString ('initPrgSpace'); *)⓪*IF ~initPrgSpace (usedIndex^.header^.prgFlags) THEN⓪,(*$ ? Trace: WriteString (' failed'); *)⓪,outOfMem;⓪,termState:= 2⓪*ELSE⓪,enterMods (TRUE, FALSE, exitCode);⓪,IF enterFailed THEN⓪.exitCode:= 0; outOfMem; termState:= 2⓪,ELSE⓪.(*$ ? Trace: WriteLn; WriteString ('ExecProcess'); *)⓪.INCL (usedIndex^.state, running);⓪.(*⓪0SetEnvelope (ehdl, enterMods, MemArea {NIL,0});⓪.*)⓪.ExecProcess (basepage, initMods, CADR (mainName),⓪;usedIndex^.header^.prgFlags, termState, exitCode);⓪.(*⓪0IF enterFailed THEN exitCode:= 0; outOfMem; termState:= 2 END;⓪0RemoveEnvelope (ehdl);⓪.*)⓪.EXCL (usedIndex^.state, running);⓪,END;⓪*END;⓪*(*$ ? Trace: WriteLn; WriteString ('removePrgSpace'); *)⓪*removePrgSpace;⓪*(*$?Trace0:Write('7');Read(inch);IF Inconsistent() THEN HALT END;*)⓪*exitMods;⓪*(*$?Trace0:Write('8');Read(inch);IF Inconsistent() THEN HALT END;*)⓪*IF termState#2 THEN⓪,IF termState<2 THEN⓪.loadres:= initFault⓪,ELSE⓪.loadres:= exitFault⓪,END;⓪,errHandler ('',loadres)⓪*END⓪(END⓪&END;⓪$ELSE⓪&loadRes:= tooManyMods;⓪&errHandler (mainName,loadRes)⓪$END;⓪$DEALLOCATE (ExecList, 0);⓪"END;⓪"ExecPtr:= lastExecPtr;⓪"ExecList:= lastExecList;⓪"(*$ ? Trace: WriteLn; WriteString ('End ExecMod'); *)⓪"(*$?Trace0:Write('9');Read(inch);IF Inconsistent() THEN HALT END;*)⓪"RETURN usedIndex⓪ END ExecMod;⓪ ⓪ ⓪ PROCEDURE Pexec ( VAR name, arg: ARRAY OF CHAR; env: ADDRESS; VAR execRes: INTEGER ): INTEGER;⓪"(*⓪#* Programm von Disk laden und starten⓪#*)⓪"VAR s:FileStr; i:INTEGER;⓪"BEGIN⓪$Assign (name,s,ok);⓪$ASSEMBLER⓪(MOVE.L env(A6),-(A7)⓪(MOVE.L arg(A6),-(A7)⓪(PEA s(A6)⓪(CLR -(A7)⓪(MOVE #$4B,-(A7)⓪(TRAP #1⓪(ADDA.W #16,A7⓪(MOVE.L execRes(A6),A0⓪(TST.L D0⓪(BPL execOK⓪(CLR i(A6)⓪(MOVE.W D0,(A0)⓪(BRA ende⓪ execOK MOVE D0,i(A6)⓪(CLR.W (A0)⓪ ende⓪&END;⓪$RETURN i⓪"END Pexec;⓪ ⓪ ⓪ TYPE modList = RECORD p: CARDINAL;⓪6a: POINTER TO ARRAY [0..5000] OF ModRef END;⓪ VAR exitList, removeList: modList;⓪ ⓪ PROCEDURE freeLists (olda, oldb: ADDRESS);⓪"BEGIN⓪$DEALLOCATE (exitList.a, 0);⓪$DEALLOCATE (removeList.a, 0);⓪$exitList.a:= olda;⓪$removeList.a:= oldb⓪"END freeLists;⓪ ⓪ PROCEDURE allocLists (VAR olda, oldb: ADDRESS): BOOLEAN;⓪"BEGIN⓪$olda:= exitList.a;⓪$oldb:= removeList.a;⓪$ALLOCATE (exitList.a, (MaxModExec+1)*SIZE(exitList.a^[0]));⓪$ALLOCATE (removeList.a, (MaxModExec+1)*SIZE(removeList.a^[0]));⓪$IF (exitList.a # NIL) & (removeList.a # NIL) THEN⓪&RETURN TRUE⓪$ELSE⓪&freeLists (olda, oldb);⓪&RETURN FALSE⓪$END⓪"END allocLists;⓪ ⓪ ⓪ PROCEDURE CallModule ( REF name : ARRAY OF Char;⓪;Paths : PathList;⓪7REF Arg : ARRAY OF Char;⓪;env : ADDRESS;⓪7VAR ExitCode : Integer;⓪7VAR ErrMsg : ARRAY OF CHAR;⓪7VAR Result : LoaderResults);⓪ ⓪"VAR myindex: ModRef; (* Index wird gebraucht fuer Release *)⓪&mname: FileStr;⓪&fname: FileStr;⓪&arg0: ArgStr;⓪&myres: LoaderResults;⓪&mymsg: String;⓪&execRes: INTEGER;⓪&isPrg, isLoaded, found: BOOLEAN;⓪&save1, save2: ADDRESS;⓪ ⓪"PROCEDURE search (REF name: ARRAY OF CHAR);⓪$BEGIN⓪&SearchFile (name,Paths,fromStart,found,fname);⓪&isPrg:= found & ~IsModule (fname);⓪$END search;⓪ ⓪"BEGIN⓪$ExitCode := 0;⓪$errmsg[0]:= 0C;⓪$IF callptr = MaxModNest-1 THEN⓪&SetMsg (9, errmsg);⓪&Result := tooManyCalls⓪$ELSE⓪&inc (callptr);⓪&Assign (name,mname,ok);⓪&Assign (arg,arg0,ok);⓪&REPEAT⓪(IF arg0[0] # CHR(127) THEN⓪*Insert (CHR(Length(arg0)),0,arg0,ok)⓪(END;⓪(myMsg[0]:=0C;⓪(chainname [callptr] := '';⓪(isLoaded:= ModLoaded (mname, FALSE, fname, myindex);⓪(IF isLoaded & ~(loaded IN myindex^.state) & (LENGTH (FileSuffix(mname))>0) THEN⓪*(* Hier soll offenbar ein Prg. gestartet werden, das mit dem⓪+* selben Namen auch schon als residentes Modul vorkommt.⓪+* Prüfen, ob das File existiert und dann doch das File starten. *)⓪*search (mname);⓪*IF isPrg THEN isLoaded:= FALSE END⓪(ELSIF ~isLoaded THEN⓪*search (fname);⓪(END;⓪(IF ~isLoaded & ~found THEN⓪*myres:= notfound;⓪*mname:= '';⓪*outerErrHandler (FileNames.FileName (fname), '', FALSE, notfound, mymsg)⓪(ELSIF ~isLoaded & isPrg THEN⓪*exitCode:= Pexec (fname,arg0,env,execRes);⓪*mname:= '';⓪*checkExecRes (execRes, myRes, fname, myMsg);⓪(ELSE⓪*IF ~allocLists (save1, save2) THEN⓪,mname:= '';⓪,SetMsg (6, mymsg);⓪,myres := outofmemory;⓪*ELSE⓪,myindex:= execmod (mname,execalways,paths,arg0,env,exitcode,mymsg,myres);⓪,IF myindex # NIL THEN⓪.Release (myindex,FALSE,FALSE)⓪,END;⓪,freeLists (save1, save2);⓪,mname := chainname [callptr];⓪,arg0 := chainarg [callptr]⓪*END⓪(END⓪&UNTIL mname[0] = 0C;⓪&Assign (mymsg,ErrMsg,ok);⓪&Result:= myres;⓪&DEC (callptr);⓪$END⓪"END CallModule;⓪ ⓪ ⓪ PROCEDURE LoadModule ( REF mname : ARRAY OF CHAR;⓪;paths : PathList;⓪7VAR mname0 : ARRAY OF CHAR;⓪7VAR errMsg : ARRAY OF CHAR;⓪7VAR result : LoaderResults);⓪"⓪"VAR dummy:INTEGER;⓪(sdum: ArgStr;⓪(idx: CARDINAL;⓪(save1, save2: ADDRESS;⓪(ref0:ModRef;⓪ ⓪"BEGIN⓪$(* darf hier nicht stehen wg. ggf. Alias zu 'mname': mname0[0]:= 0C; *)⓪$errmsg[0]:= 0C;⓪$IF ~allocLists (save1, save2) THEN⓪&SetMsg (6, errmsg);⓪&mname0[0]:= 0C;⓪&Result := outofmemory;⓪$ELSE⓪&ref0 := execmod (mname, execnever, paths, sdum, 0, dummy, errmsg, result);⓪&freeLists (save1, save2);⓪&IF ref0 # NIL THEN⓪(Assign (ref0^.codename^,mname0,ok);⓪(IF linked IN ref0^.state THEN⓪*result := denied;⓪*SetMsg (7, errmsg);⓪*idx:= PosLen ('@I',errmsg,0);⓪*Delete (errmsg,idx,2,ok);⓪*Insert (ref0^.codeName^,idx,errmsg,ok);⓪(ELSE⓪*INCL (ref0^.state,loaded);⓪(END⓪&ELSE⓪(mname0[0]:= 0C;⓪&END⓪$END⓪"END LoadModule;⓪ ⓪ ⓪ PROCEDURE freeModule (ref0: ModRef; VAR result: LoaderResults);⓪ ⓪"VAR save1, save2: ADDRESS;⓪ ⓪"BEGIN⓪$result := NoError;⓪$IF program IN ref0^.state THEN⓪&prgUnload (ref0^.codeStart);⓪&FindEntry (ModLst, ref0, ok);⓪&IF ok THEN⓪(RemoveEntry (ModLst,ok)⓪&END;⓪&DEALLOCATE (ref0,0L)⓪$ELSE⓪&IF loaded IN ref0^.state THEN⓪(EXCL (ref0^.state, loaded);⓪(IF ~ allocLists (save1, save2) THEN⓪*Result := outofmemory;⓪(ELSE⓪*Release (ref0, FALSE, FALSE);⓪*freeLists (save1, save2);⓪*IF ref0#NIL THEN⓪,result := notRemoved⓪*END⓪(END⓪&ELSE⓪(result:= denied (* Modul ist nicht geladen *)⓪&END;⓪$END⓪"END freeModule;⓪ ⓪ PROCEDURE UnLoadModule ( REF mname : ARRAY OF Char;⓪9VAR result: LoaderResults);⓪ ⓪"VAR ref0: ModRef; dummy: FileStr;⓪ ⓪"BEGIN⓪$IF ModLoaded (mname,FALSE,dummy,ref0) THEN⓪&freeModule (ref0,result)⓪$ELSE⓪&result := notFound⓪$END⓪"END UnLoadModule;⓪ ⓪ ⓪ ⓪ PROCEDURE FullRelease (VAR client: ModRef; dummy1, dummy2: BOOLEAN);⓪"(* 'client' wird auf NIL gesetzt, wenn Modul wirklich freigegeben wird *)⓪ ⓪"PROCEDURE DoRemoveInfo ( ad: ADDRESS; len: LONGCARD );⓪$BEGIN⓪&ASSEMBLER⓪(; Suche nach Prozeduren, die im angegebenen Code-Bereich liegen:⓪(MOVE.L ad(A6),D1⓪(MOVE.L D1,D2⓪(ADD.L len(A6),D2⓪(LEA RemovalRoot,A0⓪(MOVE.L A0,A1⓪&l MOVE.L RemovalEntry.prev(A0),A0 ; Liste rückwärts durchgehen⓪(CMPA.L A1,A0 ; Listenende ?⓪(BEQ e⓪(MOVE.L RemovalEntry.call(A0),D0⓪(CMP.L D1,D0 ; call < Code-Beginn ?⓪(BCS l ; ja, weitersuchen⓪(CMP.L D2,D0 ; call > Code-Ende ?⓪(BCC l ; ja, weitersuchen⓪(; Proc gefunden -> auslinken und Remove-Info⓪(MOVEM.L D1/D2/A0/A1,-(A7)⓪(MOVE.L RemovalEntry.next(A0),A1⓪(MOVE.L RemovalEntry.prev(A0),A2⓪(MOVE.L A1,RemovalEntry.next(A2)⓪(MOVE.L A2,RemovalEntry.prev(A1)⓪(MOVE.L D0,(A3)+⓪(LEA RemovalEntry.wsp(A0),A0⓪(MOVE.L A0,(A3)+⓪(JSR CallSub⓪(MOVEM.L (A7)+,D1/D2/A0/A1⓪(BRA l ; falls mehrere Removals im Modul⓪&e⓪&END⓪$END DoRemoveInfo;⓪ ⓪"PROCEDURE markNonFree;⓪ ⓪$(*⓪%* Die Module werden folgendermaßen markiert:⓪%* - folgende erhalten 'msr1' in 'state':⓪%* - linked⓪%* - program⓪%* - mainMod & running + Importe⓪%* - installed + Importe⓪%* - folgende erhalten 'loadImp' in 'state':⓪%* - loaded + Importe (ohne die, die schon 'msr1' haben)⓪%*⓪%* Alle, die 'msr1' haben, können nicht deinitialisiert werden.⓪%* Alle, die 'msr1' oder 'loadImp' haben, können nicht freigegeben werden.⓪%*)⓪ ⓪$PROCEDURE presetFlags;⓪&VAR i: ModRef;⓪&BEGIN⓪(ResetList (ModLst);⓪(LOOP⓪*i:= NextEntry (ModLst);⓪*IF i=NIL THEN EXIT END;⓪*EXCL (i^.state, loadImp);⓪*IF (linked IN i^.state) OR (program IN i^.state) THEN⓪,INCL (i^.state, msr1); (* Markiert fertige Module *)⓪*ELSE⓪,EXCL (i^.state, msr1);⓪*END⓪(END⓪&END presetFlags;⓪ ⓪$PROCEDURE markImported (i: ModRef; s: ModState);⓪&VAR j: POINTER TO ModRef;⓪&BEGIN⓪(INCL (i^.state, s);⓪(IF i^.imports # NIL THEN⓪*j:= ADR (i^.imports^);⓪*WHILE j^ # NIL DO⓪,IF NOT ( (msr1 IN j^^.state) OR (loadImp IN j^^.state) ) THEN⓪.markImported (j^, s);⓪,END;⓪,INC (j, 4)⓪*END⓪(END;⓪&END markImported;⓪ ⓪$VAR i: ModRef; s: ModStates;⓪ ⓪$BEGIN (* markNonFree *)⓪&presetFlags;⓪&ResetList (ModLst);⓪&LOOP⓪(i:= NextEntry (ModLst);⓪(IF i=NIL THEN EXIT END;⓪(s:= i^.state;⓪(IF NOT (msr1 IN s) THEN⓪*IF ( (mainMod IN s) AND (running IN s) ) OR (installed IN s) THEN⓪,markImported (i, msr1)⓪*ELSIF loaded IN s THEN⓪,markImported (i, loadImp)⓪*END⓪(END⓪&END;⓪&(*$ ? Trace:⓪(WriteLn;⓪(WriteString ('Freie Module:');⓪(ResetList (ModLst);⓪(LOOP⓪*i:= NextEntry (ModLst);⓪*IF i=NIL THEN EXIT END;⓪*IF NOT (msr1 IN i^.state) THEN⓪,WriteString (i^.codeName^);⓪,WriteString (' ');⓪*END⓪(END;⓪(WriteLn;⓪(Read(inch);⓪&*)⓪$END markNonFree;⓪ ⓪"PROCEDURE release0 (VAR client: ModRef);⓪ ⓪$PROCEDURE add (VAR list: modList);⓪&BEGIN⓪(WITH list DO⓪*IF p > MaxModExec THEN⓪,ASSEMBLER⓪0TRAP #6⓪0DC.W Overflow-$8000⓪0ACZ 'Release: Too many modules'⓪,END⓪*END;⓪*a^[p]:= client;⓪*INC (p);⓪(END;⓪&END add;⓪ ⓪$VAR j, j2: ModRef; pj: POINTER TO ModRef; deInit, removable: BOOLEAN;⓪ ⓪$BEGIN (* release0 *)⓪&(*$ ? Trace: WriteLn; WriteString ('Release: '); WriteString (client^.codeName^); *)⓪&IF msr1 IN client^.state THEN⓪((*$ ? Trace: WriteString (' / is linked or already removed - no action'); *)⓪&ELSE⓪(INCL (client^.state,msr1);⓪(deInit:= initialized IN client^.state;⓪(removable:= NOT (loadImp IN client^.state);⓪(pj:= ADDRESS (client^.imports);⓪(IF pj # NIL THEN⓪*(*$ ? Trace: WriteLn; WriteString ('< releasing imports of '); WriteString (client^.codeName^); *)⓪*LOOP⓪,j:= pj^;⓪,IF j = NIL THEN EXIT END;⓪,j2:= j;⓪,pj^:= NIL;⓪,release0 (j2); (* 'j2' wird ggf. auf NIL gesetzt *)⓪,pj^:= j;⓪,INC (pj, SIZE (pj^));⓪*END;⓪*(*$ ? Trace: WriteLn; WriteString ('> end of releasing imports of '); WriteString (client^.codeName^); *)⓪(END;⓪(IF deInit THEN add (exitList) END;⓪(IF removable THEN⓪*add (removeList);⓪*client:= NIL⓪(END⓪&END;⓪&(*$ ? Trace: Read(inch) *)⓪$END release0;⓪ ⓪"VAR listCnt: CARDINAL;⓪ ⓪"BEGIN (* FullRelease *)⓪$(*$ ? Trace2: WriteLn; WriteString ('Begin Release!'); *)⓪$IF NOT (program IN client^.state) & NOT (linked IN client^.state) THEN⓪&markNonFree;⓪&exitList.p:= 0;⓪&removeList.p:= 0;⓪&release0 (client);⓪&WITH exitList DO⓪(WHILE p > 0 DO⓪*DEC (p);⓪*(*$ ? Trace2 OR Trace: WriteLn; WriteString ('deinit '); WriteString (a^[p]^.codeName^); *)⓪*WITH a^[p]^ DO⓪,DoRemoveInfo (codeStart, codeLen);⓪,EXCL (state, initialized);⓪*END⓪(END⓪&END;⓪&WITH removeList DO⓪(WHILE p > 0 DO⓪*DEC (p);⓪*(*$ ? Trace: WriteLn; WriteString ('dealloc '); WriteString (a^[p]^.codeName^); *)⓪*FindEntry (ModLst, a^[p], ok);⓪*IF ok THEN⓪,RemoveEntry (ModLst,error);⓪,FreeMod (a^[p])⓪*ELSE⓪,ASSEMBLER⓪0TRAP #6⓪0DC.W IllegalState ; interner Fehler!⓪,END⓪*END;⓪(END⓪&END;⓪&(*$ ? Trace2: Read(inch); *)⓪$END;⓪"END FullRelease;⓪ ⓪ ⓪ PROCEDURE DummyMonitor;⓪"(*$L-*)⓪"BEGIN⓪"END DummyMonitor;⓪"(*$L+*)⓪ ⓪ PROCEDURE DummyLoading (REF a,b:ARRAY OF CHAR;c:ADDRESS;d:LONGCARD;e:ADDRESS;f:LONGCARD);⓪"BEGIN⓪"END DummyLoading;⓪ ⓪ PROCEDURE envelope (open, child: BOOLEAN; VAR exitcode: INTEGER);⓪"(*⓪#* Kontrollieren, ob der Prozeß endet, unter dem ein Modul geladen wurde.⓪#* Dann das Modul freigeben. Da der 'owner' nur dann gesetzt wird, wenn⓪#* kein SysAlloc (FullStorBaseAccess) erfolgen konnte, passiert dies nur⓪#* auf dem TT oder wenn kein erw. Storage-Access erlaubt wird.⓪#*)⓪"VAR i: ModRef; result: LoaderResults;⓪"BEGIN⓪$IF NOT open AND child THEN⓪&ResetList (ModLst);⓪&LOOP⓪(i:= NextEntry (ModLst);⓪(IF i=NIL THEN EXIT END;⓪(IF (loaded IN i^.state) & (i^.owner = ProcessID^) THEN⓪*freeModule (i, result);⓪*ResetList (ModLst); (* wieder von vorn *)⓪(END⓪&END;⓪$END⓪"END envelope;⓪ ⓪ VAR ehdl: EnvlpCarrier;⓪ ⓪ BEGIN (* of Loader *)⓪"SetEnvelope (ehdl, envelope, MemArea {NIL,0});⓪"IF UseStackFrame () THEN StackFrameOffs:= 2 ELSE StackFrameOffs:= 0 END;⓪"callptr:= 1;⓪"ExecPtr:= 0;⓪"DefaultStackSize:= 16384;⓪"Loading:= DummyLoading;⓪"Monitor:= DummyMonitor;⓪"Release:= FullRelease;⓪"(*$P+*)⓪ END Loader.⓪ ə
- (* $0000662F$000021CC$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$00005177$FFF09768$0000DC29$FFF09768$0000515F$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$00008304$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768$FFF09768Ç$00001C77T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFAD4838$FFAD4838$00005162$00008834$00008822$FFAD4838$00008822$00005967$FFAD4838$00001CA5$FFAD4838$00005173$0000515F$00001C77$00005949$FFAD4838îÇâ*)
-
